Esta práctica consiste en la realización de una segmentación de clientes en base a los datos aportados por tarjetas de crédito activas en los últimos 6 meses.
Antes de empezar con todo el trabajo, empleo la siguiente función para comprobar si están descargados todos los paquetes que voy a emplear y, en caso contrario, descargarlos:
comprobar <- function(pkg){
new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
if (length(new.pkg))
install.packages(new.pkg, dependencies = TRUE)
sapply(pkg, require, character.only = TRUE)
}
paquetes<-c("tidyverse","factoextra","FactoMineR","plfm","cluster",
"ggplot2","VIM","mice","corrplot","psych","Hmisc","rgl",
"NbClust","anacor","ca","gplots","naniar","missMDA","gmodels",
"scales","descr","caret","magrittr","gridExtra","grid","PCAmixdata")
comprobar(paquetes)
## tidyverse factoextra FactoMineR plfm cluster ggplot2 VIM
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## mice corrplot psych Hmisc rgl NbClust anacor
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## ca gplots naniar missMDA gmodels scales descr
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## caret magrittr gridExtra grid PCAmixdata
## TRUE TRUE TRUE TRUE TRUE
El primer paso consistiría en descargar los datos (se puede emplear choose.file() pero en markdown no funciona) en el directorio de trabajo a usar. Según cómo están configurados los datos, establezco que la primera columna sea el nombre de cada línea para más comodidad:
setwd("C:/Users/Diego/Desktop/Introduction to data mining/Trabajo_final_individual_1")
datos<-read.csv("datos_cluster.csv",row.names = 1)
Una vez hecho este paso, hay que observar si los datos necesitan algún tipo de preproceso en caso de que contengan datos faltantes, caracteres extraños, etc. Se puede hacer rápidamente con la función glimpse y obteniendo la suma de NA en cada variable:
glimpse(datos)
## Rows: 8,950
## Columns: 17
## $ BALANCE <dbl> 40.90075, 3202.46742, 2495.14886, ...
## $ BALANCE_FREQUENCY <dbl> 0.818182, 0.909091, 1.000000, 0.63...
## $ PURCHASES <dbl> 95.40, 0.00, 773.17, 1499.00, 16.0...
## $ ONEOFF_PURCHASES <dbl> 0.00, 0.00, 773.17, 1499.00, 16.00...
## $ INSTALLMENTS_PURCHASES <dbl> 95.40, 0.00, 0.00, 0.00, 0.00, 133...
## $ CASH_ADVANCE <dbl> 0.0000, 6442.9455, 0.0000, 205.788...
## $ PURCHASES_FREQUENCY <dbl> 0.166667, 0.000000, 1.000000, 0.08...
## $ ONEOFF_PURCHASES_FREQUENCY <dbl> 0.000000, 0.000000, 1.000000, 0.08...
## $ PURCHASES_INSTALLMENTS_FREQUENCY <dbl> 0.083333, 0.000000, 0.000000, 0.00...
## $ CASH_ADVANCE_FREQUENCY <dbl> 0.000000, 0.250000, 0.000000, 0.08...
## $ CASH_ADVANCE_TRX <int> 0, 4, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0...
## $ PURCHASES_TRX <int> 2, 0, 12, 1, 1, 8, 64, 12, 5, 3, 1...
## $ CREDIT_LIMIT <dbl> 1000, 7000, 7500, 7500, 1200, 1800...
## $ PAYMENTS <dbl> 201.8021, 4103.0326, 622.0667, 0.0...
## $ MINIMUM_PAYMENTS <dbl> 139.50979, 1072.34022, 627.28479, ...
## $ PRC_FULL_PAYMENT <dbl> 0.000000, 0.222222, 0.000000, 0.00...
## $ TENURE <int> 12, 12, 12, 12, 12, 12, 12, 12, 12...
colSums(is.na(datos))
## BALANCE BALANCE_FREQUENCY
## 0 0
## PURCHASES ONEOFF_PURCHASES
## 0 0
## INSTALLMENTS_PURCHASES CASH_ADVANCE
## 0 0
## PURCHASES_FREQUENCY ONEOFF_PURCHASES_FREQUENCY
## 0 0
## PURCHASES_INSTALLMENTS_FREQUENCY CASH_ADVANCE_FREQUENCY
## 0 0
## CASH_ADVANCE_TRX PURCHASES_TRX
## 0 0
## CREDIT_LIMIT PAYMENTS
## 1 0
## MINIMUM_PAYMENTS PRC_FULL_PAYMENT
## 313 0
## TENURE
## 0
apply(datos, 2, range)
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## [1,] 0.00 0 0.00 0.00
## [2,] 19043.14 1 49039.57 40761.25
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## [1,] 0 0.00 0
## [2,] 22500 47137.21 1
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## [1,] 0 0
## [2,] 1 1
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## [1,] 0.0 0 0 NA
## [2,] 1.5 123 358 NA
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## [1,] 0.00 NA 0 6
## [2,] 50721.48 NA 1 12
A primera vista se pueden extraer bastantes conclusiones. En primer lugar, no hay variables categóricas puras (tipo texto), sólo numéricas y binarias pero algunas de ellas levantan sospecha como ONEOFF_PURCHASES_FREQUENCY que parece contener valores repetitivos y prefijados; no hay caracteres extraños pues ninguna variable está clasificada como string y hay 314 NA cuya presencia parece estar concentrada en la variable MINIMUM_PAYMENTS.
Vizualizo los datos NA para confirmar la información extraída numéricamnete:
gg_miss_var(datos)
Efectivamente, parece que todos los NA se concentran en esta variable. Viéndolo de otra manera:
gg_miss_upset(datos)
Antes de empezar a analizar en profundidad, es necesario solucionar el problema de los NA y a la hora de lidiar con ellos, hay varias posibilidades. En primer lugar se puede proceder a su borrado, es decir, al borrado de aquellas observaciones que contengan el valor faltante siempre y cuando el dataset contenga suficientes observaciones. En este caso tenemos 8950 observaciones y 314 NA values casi no suponen el 3.5% del total. Como no se supera el 5% recomendado, no es una opción excluir las variable MINIMUM_PAYMENTS y teniendo posibilidad de imputarlos, es mejor hacerlo con el siguiente código:
library(VIM)
library(mice)
plot_NA <- aggr(datos, col=c('green','red'), numbers=TRUE,
sortVars=TRUE, labels=names(datos),
cex.axis=.3,
gap=3, ylab=c("Histogram of missing data","Pattern"))
##
## Variables sorted by number of missings:
## Variable Count
## MINIMUM_PAYMENTS 0.0349720670
## CREDIT_LIMIT 0.0001117318
## BALANCE 0.0000000000
## BALANCE_FREQUENCY 0.0000000000
## PURCHASES 0.0000000000
## ONEOFF_PURCHASES 0.0000000000
## INSTALLMENTS_PURCHASES 0.0000000000
## CASH_ADVANCE 0.0000000000
## PURCHASES_FREQUENCY 0.0000000000
## ONEOFF_PURCHASES_FREQUENCY 0.0000000000
## PURCHASES_INSTALLMENTS_FREQUENCY 0.0000000000
## CASH_ADVANCE_FREQUENCY 0.0000000000
## CASH_ADVANCE_TRX 0.0000000000
## PURCHASES_TRX 0.0000000000
## PAYMENTS 0.0000000000
## PRC_FULL_PAYMENT 0.0000000000
## TENURE 0.0000000000
Usando la librería VIM y mice y suponiendo que los datos faltantes son MCAR (totalmente aleatorios) he creado un gráfico el cual muestra la distribución de los NA y se confirma de nuevo su entera presencia en MIN_PAY.
A continuación usaré el paquete mice para crear simulaciones sobre este dataset que ayuden a apredecir los NA y como la variable en la que se encuentra es numérica, el mejor método a usar es pmm de netre los muchos que posee esta función:
datos_completos <- mice(datos,m=5,maxit=5,meth='pmm',seed=500)
##
## iter imp variable
## 1 1 CREDIT_LIMIT MINIMUM_PAYMENTS
## 1 2 CREDIT_LIMIT MINIMUM_PAYMENTS
## 1 3 CREDIT_LIMIT MINIMUM_PAYMENTS
## 1 4 CREDIT_LIMIT MINIMUM_PAYMENTS
## 1 5 CREDIT_LIMIT MINIMUM_PAYMENTS
## 2 1 CREDIT_LIMIT MINIMUM_PAYMENTS
## 2 2 CREDIT_LIMIT MINIMUM_PAYMENTS
## 2 3 CREDIT_LIMIT MINIMUM_PAYMENTS
## 2 4 CREDIT_LIMIT MINIMUM_PAYMENTS
## 2 5 CREDIT_LIMIT MINIMUM_PAYMENTS
## 3 1 CREDIT_LIMIT MINIMUM_PAYMENTS
## 3 2 CREDIT_LIMIT MINIMUM_PAYMENTS
## 3 3 CREDIT_LIMIT MINIMUM_PAYMENTS
## 3 4 CREDIT_LIMIT MINIMUM_PAYMENTS
## 3 5 CREDIT_LIMIT MINIMUM_PAYMENTS
## 4 1 CREDIT_LIMIT MINIMUM_PAYMENTS
## 4 2 CREDIT_LIMIT MINIMUM_PAYMENTS
## 4 3 CREDIT_LIMIT MINIMUM_PAYMENTS
## 4 4 CREDIT_LIMIT MINIMUM_PAYMENTS
## 4 5 CREDIT_LIMIT MINIMUM_PAYMENTS
## 5 1 CREDIT_LIMIT MINIMUM_PAYMENTS
## 5 2 CREDIT_LIMIT MINIMUM_PAYMENTS
## 5 3 CREDIT_LIMIT MINIMUM_PAYMENTS
## 5 4 CREDIT_LIMIT MINIMUM_PAYMENTS
## 5 5 CREDIT_LIMIT MINIMUM_PAYMENTS
summary(datos_completos)
## Class: mids
## Number of multiple imputations: 5
## Imputation methods:
## BALANCE BALANCE_FREQUENCY
## "" ""
## PURCHASES ONEOFF_PURCHASES
## "" ""
## INSTALLMENTS_PURCHASES CASH_ADVANCE
## "" ""
## PURCHASES_FREQUENCY ONEOFF_PURCHASES_FREQUENCY
## "" ""
## PURCHASES_INSTALLMENTS_FREQUENCY CASH_ADVANCE_FREQUENCY
## "" ""
## CASH_ADVANCE_TRX PURCHASES_TRX
## "" ""
## CREDIT_LIMIT PAYMENTS
## "pmm" ""
## MINIMUM_PAYMENTS PRC_FULL_PAYMENT
## "pmm" ""
## TENURE
## ""
## PredictorMatrix:
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## BALANCE 0 1 1 1
## BALANCE_FREQUENCY 1 0 1 1
## PURCHASES 1 1 0 1
## ONEOFF_PURCHASES 1 1 1 0
## INSTALLMENTS_PURCHASES 1 1 1 1
## CASH_ADVANCE 1 1 1 1
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## BALANCE 1 1 1
## BALANCE_FREQUENCY 1 1 1
## PURCHASES 1 1 1
## ONEOFF_PURCHASES 1 1 1
## INSTALLMENTS_PURCHASES 0 1 1
## CASH_ADVANCE 1 0 1
## ONEOFF_PURCHASES_FREQUENCY
## BALANCE 1
## BALANCE_FREQUENCY 1
## PURCHASES 1
## ONEOFF_PURCHASES 1
## INSTALLMENTS_PURCHASES 1
## CASH_ADVANCE 1
## PURCHASES_INSTALLMENTS_FREQUENCY CASH_ADVANCE_FREQUENCY
## BALANCE 1 1
## BALANCE_FREQUENCY 1 1
## PURCHASES 1 1
## ONEOFF_PURCHASES 1 1
## INSTALLMENTS_PURCHASES 1 1
## CASH_ADVANCE 1 1
## CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT PAYMENTS
## BALANCE 1 1 1 1
## BALANCE_FREQUENCY 1 1 1 1
## PURCHASES 1 1 1 1
## ONEOFF_PURCHASES 1 1 1 1
## INSTALLMENTS_PURCHASES 1 1 1 1
## CASH_ADVANCE 1 1 1 1
## MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## BALANCE 1 1 1
## BALANCE_FREQUENCY 1 1 1
## PURCHASES 1 1 1
## ONEOFF_PURCHASES 1 1 1
## INSTALLMENTS_PURCHASES 1 1 1
## CASH_ADVANCE 1 1 1
## Number of logged events: 50
## it im dep meth out
## 1 1 1 CREDIT_LIMIT pmm PURCHASES
## 2 1 1 MINIMUM_PAYMENTS pmm PURCHASES
## 3 1 2 CREDIT_LIMIT pmm PURCHASES
## 4 1 2 MINIMUM_PAYMENTS pmm PURCHASES
## 5 1 3 CREDIT_LIMIT pmm PURCHASES
## 6 1 3 MINIMUM_PAYMENTS pmm PURCHASES
datos<-complete(datos_completos,1)
densityplot(datos_completos)
Tras generar los datos incompletos, creo el dataset de nuevo con esos datos añadidos y, echando un vistazo a las distribuciones de la simulación, parece que logran asemejarse a la distribución de la variable original.
Dado que el objetivo es realizar un análisis cluster y de PCA, es conveniente hacer una revisión de las variables para conocer sus características y entender su comportamiento. EL paquete psych contiene una función que resume todas las variables del dataset:
library(psych)
describe(datos)
## datos
##
## 17 Variables 8950 Observations
## --------------------------------------------------------------------------------
## BALANCE
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 8871 1 1564 1948 8.815 23.576
## .25 .50 .75 .90 .95
## 128.282 873.385 2054.140 4338.564 5909.112
##
## lowest : 0.000000 0.000199 0.001146 0.001214 0.001289
## highest: 16115.596400 16259.448570 16304.889250 18495.558550 19043.138560
## --------------------------------------------------------------------------------
## BALANCE_FREQUENCY
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 43 0.666 0.8773 0.1986 0.2727 0.4545
## .25 .50 .75 .90 .95
## 0.8889 1.0000 1.0000 1.0000 1.0000
##
## lowest : 0.000000 0.090909 0.100000 0.111111 0.125000
## highest: 0.875000 0.888889 0.900000 0.909091 1.000000
## --------------------------------------------------------------------------------
## PURCHASES
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 6203 0.988 1003 1421 0.00 0.00
## .25 .50 .75 .90 .95
## 39.63 361.28 1110.13 2542.62 3998.62
##
## lowest : 0.00 0.01 0.05 0.24 0.70
## highest: 35131.16 38902.71 40040.71 41050.40 49039.57
## --------------------------------------------------------------------------------
## ONEOFF_PURCHASES
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 4014 0.889 592.4 957.4 0.0 0.0
## .25 .50 .75 .90 .95
## 0.0 38.0 577.4 1600.1 2671.1
##
## lowest : 0.00 0.01 0.02 0.05 0.24
## highest: 26547.43 33803.84 34087.73 40624.06 40761.25
## --------------------------------------------------------------------------------
## INSTALLMENTS_PURCHASES
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 4452 0.916 411.1 621.7 0.0 0.0
## .25 .50 .75 .90 .95
## 0.0 89.0 468.6 1140.1 1750.1
##
## lowest : 0.00 1.95 4.44 4.80 6.33
## highest: 12738.47 13184.43 14686.10 15497.19 22500.00
## --------------------------------------------------------------------------------
## CASH_ADVANCE
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 4323 0.862 978.9 1549 0 0
## .25 .50 .75 .90 .95
## 0 0 1114 3066 4647
##
## lowest : 0.00000 14.22222 18.04277 18.11797 18.12341
## highest: 26194.04954 26268.69989 27296.48576 29282.10915 47137.21176
## --------------------------------------------------------------------------------
## PURCHASES_FREQUENCY
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 47 0.973 0.4904 0.4519 0.00000 0.00000
## .25 .50 .75 .90 .95
## 0.08333 0.50000 0.91667 1.00000 1.00000
##
## lowest : 0.000000 0.083333 0.090909 0.100000 0.111111
## highest: 0.888889 0.900000 0.909091 0.916667 1.000000
## --------------------------------------------------------------------------------
## ONEOFF_PURCHASES_FREQUENCY
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 47 0.886 0.2025 0.2869 0.00000 0.00000
## .25 .50 .75 .90 .95
## 0.00000 0.08333 0.30000 0.75000 1.00000
##
## lowest : 0.000000 0.083333 0.090909 0.100000 0.111111
## highest: 0.888889 0.900000 0.909091 0.916667 1.000000
## --------------------------------------------------------------------------------
## PURCHASES_INSTALLMENTS_FREQUENCY
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 47 0.913 0.3644 0.4305 0.0000 0.0000
## .25 .50 .75 .90 .95
## 0.0000 0.1667 0.7500 1.0000 1.0000
##
## lowest : 0.000000 0.083333 0.090909 0.100000 0.111111
## highest: 0.888889 0.900000 0.909091 0.916667 1.000000
## --------------------------------------------------------------------------------
## CASH_ADVANCE_FREQUENCY
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 54 0.859 0.1351 0.1902 0.0000 0.0000
## .25 .50 .75 .90 .95
## 0.0000 0.0000 0.2222 0.4167 0.5833
##
## lowest : 0.000000 0.083333 0.090909 0.100000 0.111111
## highest: 1.125000 1.142857 1.166667 1.250000 1.500000
## --------------------------------------------------------------------------------
## CASH_ADVANCE_TRX
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 65 0.86 3.249 5.014 0 0
## .25 .50 .75 .90 .95
## 0 0 4 10 15
##
## lowest : 0 1 2 3 4, highest: 80 93 107 110 123
## --------------------------------------------------------------------------------
## PURCHASES_TRX
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 173 0.987 14.71 19.64 0 0
## .25 .50 .75 .90 .95
## 1 7 17 37 57
##
## lowest : 0 1 2 3 4, highest: 308 309 344 347 358
## --------------------------------------------------------------------------------
## CREDIT_LIMIT
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 205 0.997 4494 3783 1000 1200
## .25 .50 .75 .90 .95
## 1600 3000 6500 9500 12000
##
## lowest : 50 150 200 300 400, highest: 22500 23000 25000 28000 30000
## --------------------------------------------------------------------------------
## PAYMENTS
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 8711 1 1733 2087 89.99 179.62
## .25 .50 .75 .90 .95
## 383.28 856.90 1901.13 3923.91 6082.09
##
## lowest : 0.000000 0.049513 0.056466 2.389583 3.500505
## highest: 39048.597620 39461.965800 40627.595240 46930.598240 50721.483360
## --------------------------------------------------------------------------------
## MINIMUM_PAYMENTS
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 8636 1 846.7 1118 72.35 103.59
## .25 .50 .75 .90 .95
## 167.81 301.72 798.35 1741.29 2731.41
##
## lowest : 0.019163 0.037744 0.055880 0.059481 0.117036
## highest: 43132.728230 50260.759470 56370.041170 61031.618600 76406.207520
## --------------------------------------------------------------------------------
## PRC_FULL_PAYMENT
## n missing distinct Info Mean Gmd .05 .10
## 8950 0 47 0.713 0.1537 0.247 0.0000 0.0000
## .25 .50 .75 .90 .95
## 0.0000 0.0000 0.1429 0.6700 1.0000
##
## lowest : 0.000000 0.083333 0.090909 0.100000 0.111111
## highest: 0.888889 0.900000 0.909091 0.916667 1.000000
## --------------------------------------------------------------------------------
## TENURE
## n missing distinct Info Mean Gmd
## 8950 0 7 0.391 11.52 0.8656
##
## lowest : 6 7 8 9 10, highest: 8 9 10 11 12
##
## Value 6 7 8 9 10 11 12
## Frequency 204 190 196 175 236 365 7584
## Proportion 0.023 0.021 0.022 0.020 0.026 0.041 0.847
## --------------------------------------------------------------------------------
Se puede decir que hay bastantes variables que toman valores entre 0 y 1 pero ninguna propiamente binaria que tome únicamente valor 0 o 1. Lo que sí que hay son variables que podrían considerarse como categóricas al ser valores que se repiten y tienen una componente más descriptiva que cuantitativa y deberían ponerse como factor. Este detalle se puede ver fácilmente de la siguiente manera:
unique_val<-datos %>% apply(2,unique) %>% lapply(length)
barplot(unlist(unique_val),xlab="Variables",ylab="Total valores únicos",col="lightblue",cex.names = 0.5,las=2)
Con ese vistazo se puede saber que algunas de las variables poseen muy pocos valores diferentes, únicos, y que podrían considerarse como variables categóricas. También hay que tener en cuenta que puede haber muchos valores 0 y que eso haga parecer que lo son. Con el siguiente código puedo ver aquellos que tienen menos de 50 valores diferentes y ordenarlos para comparar si toman los mismos valores en cada una de las variables a las que pertenecen:
datos_aux<-apply(datos, 2, unique)
datos_aux<-lapply(datos_aux, sort)
datos_aux[lapply(datos_aux, length)<50]
## $BALANCE_FREQUENCY
## [1] 0.000000 0.090909 0.100000 0.111111 0.125000 0.142857 0.166667 0.181818
## [9] 0.200000 0.222222 0.250000 0.272727 0.285714 0.300000 0.333333 0.363636
## [17] 0.375000 0.400000 0.428571 0.444444 0.454545 0.500000 0.545455 0.555556
## [25] 0.571429 0.600000 0.625000 0.636364 0.666667 0.700000 0.714286 0.727273
## [33] 0.750000 0.777778 0.800000 0.818182 0.833333 0.857143 0.875000 0.888889
## [41] 0.900000 0.909091 1.000000
##
## $PURCHASES_FREQUENCY
## [1] 0.000000 0.083333 0.090909 0.100000 0.111111 0.125000 0.142857 0.166667
## [9] 0.181818 0.200000 0.222222 0.250000 0.272727 0.285714 0.300000 0.333333
## [17] 0.363636 0.375000 0.400000 0.416667 0.428571 0.444444 0.454545 0.500000
## [25] 0.545455 0.555556 0.571429 0.583333 0.600000 0.625000 0.636364 0.666667
## [33] 0.700000 0.714286 0.727273 0.750000 0.777778 0.800000 0.818182 0.833333
## [41] 0.857143 0.875000 0.888889 0.900000 0.909091 0.916667 1.000000
##
## $ONEOFF_PURCHASES_FREQUENCY
## [1] 0.000000 0.083333 0.090909 0.100000 0.111111 0.125000 0.142857 0.166667
## [9] 0.181818 0.200000 0.222222 0.250000 0.272727 0.285714 0.300000 0.333333
## [17] 0.363636 0.375000 0.400000 0.416667 0.428571 0.444444 0.454545 0.500000
## [25] 0.545455 0.555556 0.571429 0.583333 0.600000 0.625000 0.636364 0.666667
## [33] 0.700000 0.714286 0.727273 0.750000 0.777778 0.800000 0.818182 0.833333
## [41] 0.857143 0.875000 0.888889 0.900000 0.909091 0.916667 1.000000
##
## $PURCHASES_INSTALLMENTS_FREQUENCY
## [1] 0.000000 0.083333 0.090909 0.100000 0.111111 0.125000 0.142857 0.166667
## [9] 0.181818 0.200000 0.222222 0.250000 0.272727 0.285714 0.300000 0.333333
## [17] 0.363636 0.375000 0.400000 0.416667 0.428571 0.444444 0.454545 0.500000
## [25] 0.545455 0.555556 0.571429 0.583333 0.600000 0.625000 0.636364 0.666667
## [33] 0.700000 0.714286 0.727273 0.750000 0.777778 0.800000 0.818182 0.833333
## [41] 0.857143 0.875000 0.888889 0.900000 0.909091 0.916667 1.000000
##
## $PRC_FULL_PAYMENT
## [1] 0.000000 0.083333 0.090909 0.100000 0.111111 0.125000 0.142857 0.166667
## [9] 0.181818 0.200000 0.222222 0.250000 0.272727 0.285714 0.300000 0.333333
## [17] 0.363636 0.375000 0.400000 0.416667 0.428571 0.444444 0.454545 0.500000
## [25] 0.545455 0.555556 0.571429 0.583333 0.600000 0.625000 0.636364 0.666667
## [33] 0.700000 0.714286 0.727273 0.750000 0.777778 0.800000 0.818182 0.833333
## [41] 0.857143 0.875000 0.888889 0.900000 0.909091 0.916667 1.000000
##
## $TENURE
## [1] 6 7 8 9 10 11 12
Efectivamente, las variables que llevan al final la palabra FREQUENCY tienen los mismos valores únicos y se podrían considerar como factores de cara al análisis cluster y PCA. TENURE también entra dentro de este grupo.
Comprobar las distribuciones de cada una de las variables puede ser una buena idea de cara a saber cómo se distribuyen las variables y en los casos en que es necesario estandarizar:
ggplot(gather(as.data.frame(datos)), aes(value)) +
geom_histogram(bins = 15, color="blue", fill="white") +
facet_wrap(~key, scales = 'free')+
theme_classic()
Las distribuciones distan mucho de ser normales y, además, poseen escalas muy dispares. Sin embargo, todas ellas permiten una segregación muy bien definida entre tipos de clientes por lo que aplicarles logaritmos podría eliminar esta información y concluimos que es mejor realizar solamente una estandarización en media. Esta segregación es muy clara en variables como Purchases Frequency o Installments Frequency permitiendo distinguir entre muy poca frecuencia y alta frecuencia.
También podría ser interesante comprobar las correlaciones entre las distintas variables por ver cómo se influyen unas en otras. Para hacerlo, se puede usar una función que proporciona p-valores a cada una de las correlaciones y emplear eso luego para representar sólo aquellas que tengan un nivel de significación determinado (en este caso 1%):
res2<-rcorr(as.matrix(datos))
cor_matrix<-cor(datos)
corrplot(res2$r, type="upper", order="hclust",
p.mat = res2$P, sig.level = 0.01,
insig = "blank",tl.cex = 0.5,
tl.col = "black",
tl.srt = 45)
Estos datos arrojan información importante como que hay bastantes variables poco correlacionadas y en la gran mayoría de las que sí tienen correlación, esta es positiva. Hay algunas que que no poseen casi correlación con ninguna de las otras variables como TENURE, MINIMUM_PAYMENTS O BALANCE FREQUENCY y probaré a excluirlas del análisis PCA pues no van a proporcionar información extra y reduciendo el número de variables se incrementa la varianza explicada:
datos2<-datos %>% select(-c(TENURE,MINIMUM_PAYMENTS,BALANCE_FREQUENCY))
res2<-rcorr(as.matrix(datos2))
cor_matrix<-cor(datos2)
corrplot(res2$r, type="upper", order="hclust",
p.mat = res2$P, sig.level = 0.01,
insig = "blank",tl.cex = 0.5,
tl.col = "black",
tl.srt = 45)
Dentro de este análisis preliminar exploraré más a fondo aquellas variables con más correlación o muy indicativas de la tipología de los clienets bancarios destacando BALANCE, PURCHASES, PAYMENTS o CASH_ADVANCE.
Empezando con el BALANCE, es de suponer que se concentre en niveles cercanos a 0 euros y haya bastantes outliers:
layout(mat = matrix(c(1,2),2,1, byrow=TRUE), height = c(1,8))
par(mar=c(0, 3.1, 1.1, 2.1))
boxplot(datos$BALANCE , horizontal=TRUE , xaxt="n" , col=rgb(0.8,0.8,0,0.5) , frame=F)
par(mar=c(4, 3.1, 1.1, 2.1))
hist(datos$BALANCE, breaks=40 , col=rgb(0.2,0.8,0.5,0.5) , border=F , main="" , xlab="Saldo en cuenta")
Como puede verse, la enorme mayoría de los clientes (más del 75%) no superan los 5000 euros en cuenta pero hay muchos outliers que contribuyen a que la distribución tenga una cola muy gruesa hacia la derecha.
En cuanto a la variable compras:
layout(mat = matrix(c(1,2),2,1, byrow=TRUE), height = c(1,8))
par(mar=c(0, 3.1, 1.1, 2.1))
boxplot(datos$PURCHASES , horizontal=TRUE , xaxt="n" , col=rgb(0.8,0.8,0,0.5) , frame=F)
par(mar=c(4, 3.1, 1.1, 2.1))
hist(datos$PURCHASES, breaks=40 , col=rgb(0.2,0.8,0.5,0.5) , border=F , main="" , xlab="Número de compras realizadas")
Las compras realizadas por cada usuario están de manera más clara que antes situadas cerca de 0 ya que no es habitual comprar con una frecuencia extrema. SI hubiera datos sobre las fechas en que se producen las transacciones, sería de mucha utilidad para saber los períodos en los que hay más demanda y en los que realizar campañas de captación.
Pasando a los PAYMENTS
layout(mat = matrix(c(1,2),2,1, byrow=TRUE), height = c(1,8))
par(mar=c(0, 3.1, 1.1, 2.1))
boxplot(datos$PAYMENTS , horizontal=TRUE , xaxt="n" , col=rgb(0.8,0.8,0,0.5) , frame=F)
par(mar=c(4, 3.1, 1.1, 2.1))
hist(datos$PAYMENTS, breaks=40 , col=rgb(0.2,0.8,0.5,0.5) , border=F , main="" , xlab="Saldo en cuenta")
Los importes de las compras también se acumulan por debajo de los 10.000 pues la mayor parte de la gente no puede permitirse gastos muy elevados.
Relativo a las variables que representan frecuencia, podemos usar gráficos para ver qué es lo más frecuente:
bfreq<-table(datos$BALANCE_FREQUENCY)
bfreq<-prop.table(bfreq)
bfreq<-as.data.frame(bfreq)
names(bfreq)<-c("Frecuencia", "Porcentaje")
ggplot(data=bfreq, mapping=aes(x=Frecuencia, y=Porcentaje)) +
geom_col(fill="orange", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Frecuencia de actualización del Balance",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Frecuencia, y=Porcentaje,
label=percent(Porcentaje)), size=3,
nudge_y=0.03)+
coord_flip()
El 70% de los clientes actualizan el Balance de manera frecuente, es decir, son cuentas activas que realizan movimientos. Para el resto de posibles frecuencias sólo hay porcentajes distribuidos muy homogéneamente hasta completar el 30% restante.
En cuanto a la frecuencia de las compras:
pfreq<-table(datos$PURCHASES_FREQUENCY)
pfreq<-prop.table(pfreq)
pfreq<-as.data.frame(pfreq)
names(pfreq)<-c("Frecuencia", "Porcentaje")
ggplot(data=pfreq, mapping=aes(x=Frecuencia, y=Porcentaje)) +
geom_col(fill="orange", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Frecuencia de compras",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Frecuencia, y=Porcentaje,
label=percent(Porcentaje)), size=3,
nudge_y=0.03)+
coord_flip()
Por otro lado, la frecuencia de las compras nos muestra que hay un 20% de personas que compran muy frecuentemente, otro 20% que no compra nunca y el 60% resultante está repartido entre los valores intermedios por lo que puede ser considerado como factor a tener en cuenta a la hora de hacer grupos. Resaltar simplemente que es curiosa la disposición de las barras con un patrón que se repite a lo largo de todas la sfrecuencias.
Tras analizar correlaciones y tener una idea general de los datos, pasaré a realizar el análisis de componenetes principales.
Hacer PCA no implica obtener interpretabilidad en los datos sino actuar como ayuda para hacerse una idea de las distribuciones. En el apartado de análisis ya se ha visto que, pese a que todas las variables podrían considerarse numéricas, hay muchas que tienen parecido con categóricas por su caracter discreto. Por todo esto, realizaré 2 tipos de análisis, el PCA normal y el FAMD para ver las diferencias entre los distintos resultados.
El primer paso que haré será escalar los datos al tener magnitudes muy dispares entre variables. Se puede usar la función scale o PCA que directamente crea el objeto de las componentes:
datos_scaled<-scale(datos)
pccomp_clientes<- PCA(datos_scaled,graph=F)
fviz_eig(pccomp_clientes,addlabels = T,ylim=c(0,50))
summary(pccomp_clientes)
##
## Call:
## PCA(X = datos_scaled, graph = F)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 4.641 3.454 1.500 1.272 1.056 0.976 0.830
## % of var. 27.300 20.318 8.821 7.485 6.212 5.740 4.884
## Cumulative % of var. 27.300 47.618 56.439 63.924 70.136 75.876 80.760
## Dim.8 Dim.9 Dim.10 Dim.11 Dim.12 Dim.13 Dim.14
## Variance 0.731 0.645 0.524 0.403 0.301 0.243 0.207
## % of var. 4.301 3.792 3.080 2.372 1.772 1.427 1.217
## Cumulative % of var. 85.061 88.853 91.933 94.305 96.077 97.503 98.720
## Dim.15 Dim.16 Dim.17
## Variance 0.172 0.045 0.000
## % of var. 1.012 0.267 0.000
## Cumulative % of var. 99.733 100.000 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2
## C10001 | 2.345 | -1.684 0.007 0.516 | -1.072
## C10002 | 3.579 | -1.133 0.003 0.100 | 2.509
## C10003 | 3.529 | 0.969 0.002 0.075 | -0.384
## C10004 | 2.403 | -0.893 0.002 0.138 | -0.007
## C10005 | 2.366 | -1.600 0.006 0.458 | -0.683
## C10006 | 2.195 | 0.253 0.000 0.013 | -0.776
## C10007 | 7.372 | 6.349 0.097 0.742 | -0.709
## C10008 | 2.636 | 0.276 0.000 0.011 | -1.288
## C10009 | 1.706 | -0.442 0.000 0.067 | -0.459
## C10010 | 3.032 | -0.564 0.001 0.035 | -0.367
## ctr cos2 Dim.3 ctr cos2
## C10001 0.004 0.209 | -0.471 0.002 0.040 |
## C10002 0.020 0.492 | -0.604 0.003 0.029 |
## C10003 0.000 0.012 | -0.085 0.000 0.001 |
## C10004 0.000 0.000 | -1.510 0.017 0.395 |
## C10005 0.002 0.083 | -0.342 0.001 0.021 |
## C10006 0.002 0.125 | 1.155 0.010 0.277 |
## C10007 0.002 0.009 | -2.095 0.033 0.081 |
## C10008 0.005 0.239 | 1.830 0.025 0.482 |
## C10009 0.001 0.072 | -0.173 0.000 0.010 |
## C10010 0.000 0.015 | -1.938 0.028 0.409 |
##
## Variables (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2
## BALANCE | 0.220 1.039 0.048 | 0.751 16.313 0.563
## BALANCE_FREQUENCY | 0.260 1.455 0.068 | 0.244 1.731 0.060
## PURCHASES | 0.887 16.937 0.786 | 0.074 0.158 0.005
## ONEOFF_PURCHASES | 0.746 11.994 0.557 | 0.115 0.380 0.013
## INSTALLMENTS_PURCHASES | 0.725 11.339 0.526 | -0.036 0.038 0.001
## CASH_ADVANCE | -0.049 0.051 0.002 | 0.816 19.267 0.665
## PURCHASES_FREQUENCY | 0.692 10.315 0.479 | -0.355 3.656 0.126
## ONEOFF_PURCHASES_FREQUENCY | 0.634 8.671 0.402 | -0.035 0.035 0.001
## PURCHASES_INSTALLMENTS_FREQUENCY | 0.591 7.532 0.350 | -0.333 3.201 0.111
## CASH_ADVANCE_FREQUENCY | -0.191 0.782 0.036 | 0.807 18.843 0.651
## Dim.3 ctr cos2
## BALANCE | 0.199 2.652 0.040 |
## BALANCE_FREQUENCY | 0.519 17.941 0.269 |
## PURCHASES | -0.315 6.614 0.099 |
## ONEOFF_PURCHASES | -0.478 15.228 0.228 |
## INSTALLMENTS_PURCHASES | 0.133 1.182 0.018 |
## CASH_ADVANCE | 0.026 0.046 0.001 |
## PURCHASES_FREQUENCY | 0.453 13.700 0.205 |
## ONEOFF_PURCHASES_FREQUENCY | -0.141 1.333 0.020 |
## PURCHASES_INSTALLMENTS_FREQUENCY | 0.573 21.906 0.328 |
## CASH_ADVANCE_FREQUENCY | 0.126 1.057 0.016 |
Normalmente, en componentes principales con pocas variables la variablidad suele estar recogida casi al completo por las componentes 1 y 2 y en estos datos representan el 56.3% de la volatilidad. Ampliando la representación hasta la 4 dimensión se llegaría al 70% pero con una visualización imposible.
Para establecer un límite sobre las dimensiones que son lo suficientemente aptas, fijaré que 1 sea el mínimo valor a escoger para los eigenvalues. Las variables que posean un eigenvalue menor que 1 estarían explicando menor variabilidad que una sola de las variables de por sí y, por tanto, son prescindibles. Para ello primero represneo el screeplot con el límite horizontal de 1:
pccomp_clientes2<-prcomp(datos,scale. = T)
screeplot(pccomp_clientes2, type = "l", npcs = 15, main = "Gráfico de las primeras componentes")
abline(h = 1, col="red", lty=5)
legend("topright", legend=c("Eigenvalue = 1"),
col=c("red"), lty=5, cex=0.6)
Y a continuación la varianza en base a los componentes para ver cómo se comporta de manera asintótica hacia el 100%:
cumpro <- cumsum(pccomp_clientes2$sdev^2 / sum(pccomp_clientes2$sdev^2))
plot(cumpro[0:15], xlab = "PC #", ylab = "Varianza explicada", main = "Gráfico varianza acumulada")
abline(v = 6, col="blue", lty=5)
abline(h = 0.76, col="blue", lty=5)
legend("topleft", legend=c("Punto Corte en PC6"),
col=c("blue"), lty=5, cex=0.6)
Con 6 componentes estaríaa explicando cerca del 80% de la varianza y, además, son las que poseen un eigenvalue superior a 1.
En cuanto a la contribución que tiene cada variable sobre las componentes:
fviz_pca_var(pccomp_clientes, col.var="contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE # Avoid text overlapping
) + theme_minimal() + ggtitle("Variables - PCA")
PURCHASES y las variables relacionadas con la retirada de efectivo parecen ser las que más contribuyen a las 2 componentes principales pero todas las demás también tienen contribuciones no muy por debajo destacando PAYMENTS y BALANCE.
En datasets con variables categóricas, pueden usarse estas mismas variables para distinguir grupos dentro del PCA, se puede probar con TENURE y alguna de las que llevan asociada la palabra FREQUENCY para ver si es distinguible:
groups <- as.factor(datos$TENURE)
fviz_pca_ind(pccomp_clientes, geom.ind = "point", pointshape = 21,
pointsize = 2,
fill.ind = groups,
col.ind = "black",
palette = "Blues",
addEllipses = TRUE,
label = "var",
col.var = "black",
legend.title = "TENURE") +
ggtitle("PCA con 2 compon. principales") +
theme(plot.title = element_text(hjust = 0.5))
Con este gráfico puede interpretarse que los clientes que poseen las tarjetas desde hace menos tiempo son los que están más cerca de la normalidad llegando la parte más cambiante en aquellos que poseen la tarjeta desde hace mínimo 12 meses. Es probable porque aquellos que llevan poco tiempo con ella puede ser que no confíen tanto en la marca aún o no tengan tanta confianza como para depositar mucho dinero en la cuenta, etc.
En vez de con TENURE, introduzco como color alguna de las variables que representan frecuencia:
fviz_pca_ind(pccomp_clientes, geom.ind = "point", pointshape = 21,
pointsize = 2,
fill.ind = as.factor(datos$PURCHASES_FREQUENCY),
col.ind = "black",
label = "var",
col.var = "black",
legend.title = "Diagnosis") +
ggtitle("PCA con 2 compon. principales") +
theme(plot.title = element_text(hjust = 0.5))
Con PURCHASES_FREQUENCY, queda reflejado que aquellos clientes con una frecuencia más cercana a 0 están más explicados por la componente 2 mientras que los que están más cerca de 1 se distribuyen más a lo largo de la componente 1. Al principio del PCA, la componente 1 estaba muy relacionada con la variable PURCHASES y similares mientras que la componente 2 estaba más relacionada con el BALANCE y CASH_ADVANCE lo que muestra una diferenciación de clientes.
Representando la contribución a la varianza a modo de correlograma:
var <- get_pca_var(pccomp_clientes)
corrplot(var$contrib,is.corr=F,tl.cex = 0.6,tl.col = "black")
Y la contribución de cada variable a las componentes 1 y 2:
fviz_contrib(pccomp_clientes, "var", axes = 1)
Las que más afectan a la primera componente son las relacionadas con las compras y las variables que representan frecuencia:
fviz_contrib(pccomp_clientes, "var", axes = 2)
Y las que influyen en la segunda componente son las de balance y el dinero en efectivo.
Es lógico que sea así porque es lo que esperaría que identifique a la mayoría de clientes en este tipo de negocios.
Este método permite hacer PCA sobre conjuntos de datos mixtos (con variables categóricas o discretas y continuas). Para que proporcione información correcta, las variables consideradas factor no deben poseer muchos niveles, sino reflejar un número de grupos pequeño. De lo contrario, la variabilidad explicada será casi nula pues las variables no podrían ser consideradas como categóricas.
Para ver esta peculiaridad creo 2 dataset, uno con todas las variables que podrían se rcategóricas transformadas en factor y otro sólo con TENURE como factor:
columna <- c("TENURE")
columnas<-c("BALANCE_FREQUENCY", "PURCHASES_FREQUENCY",
"ONEOFF_PURCHASES_FREQUENCY", "PURCHASES_INSTALLMENTS_FREQUENCY",
"CASH_ADVANCE_FREQUENCY","CREDIT_LIMIT",
"CASH_ADVANCE_TRX","PURCHASES_TRX",
"PRC_FULL_PAYMENT","TENURE")
datos_famd_incorrectos<-datos
datos_famd_correctos<-datos
datos_famd_incorrectos[columnas] <- lapply(datos_famd_incorrectos[columnas], factor)
datos_famd_correctos[columna]<- lapply(datos_famd_correctos[columna], factor)
Para ahora aplicar la función FAMD a cada una de las 2 posibilidades y comparar cuál resulta más fiable:
res.famd.incorrect <- FAMD(datos_famd_incorrectos,ncp=5,graph = FALSE)
a <- fviz_eig(res.famd.incorrect,
choice='eigenvalue',
geom='line')
b <- fviz_eig(res.famd.incorrect)
grid.arrange(a, b, ncol=2)
La variabilidad explicada con las primeras 5 dimensiones no sobrepasaría el 5% y las conclusiones que ofrecería serían muy pobres. Usando sólo la variable TENURE que posee 5 niveles:
res.famd.correct <- FAMD(datos_famd_correctos,ncp=5,graph = FALSE)
a <- fviz_eig(res.famd.correct,
choice='eigenvalue',
geom='line')
b <- fviz_eig(res.famd.correct)
grid.arrange(a, b, ncol=2)
Con las primeras 5 componentes estaría explicando el 54% de la variabilidad De esta manera, crearé un dataset alternativo reduciendo todos los niveles de frecuencias a menos de la mitad:
0-0.25: Muy baja 0.26-0.5: Baja 0.51-0.75: Alta 0.76-1: Muy alta
Al sustituir tan sólo una de las observaciones por factor empleando criterios numéricos, el resto de código deja de funcionar por lo que sólo he podido hacer el proceso de sustitución intercambiando rangos de valores por un único número y luego sustituirlo por el texto.
Para la variable ONEOFF_PURCHASES_FREQUENCY:
dfreq<-datos
dfreq$ONEOFF_PURCHASES_FREQUENCY<-replace(dfreq$ONEOFF_PURCHASES_FREQUENCY,dfreq$ONEOFF_PURCHASES_FREQUENCY<0.25,0.15)
dfreq$ONEOFF_PURCHASES_FREQUENCY<-replace(dfreq$ONEOFF_PURCHASES_FREQUENCY,dfreq$ONEOFF_PURCHASES_FREQUENCY>=0.25 & dfreq$ONEOFF_PURCHASES_FREQUENCY<0.5,0.35)
dfreq$ONEOFF_PURCHASES_FREQUENCY<-replace(dfreq$ONEOFF_PURCHASES_FREQUENCY,dfreq$ONEOFF_PURCHASES_FREQUENCY>=0.5 & dfreq$ONEOFF_PURCHASES_FREQUENCY<0.75,0.65)
dfreq$ONEOFF_PURCHASES_FREQUENCY<-replace(dfreq$ONEOFF_PURCHASES_FREQUENCY,dfreq$ONEOFF_PURCHASES_FREQUENCY>=0.75,0.9)
dfreq$ONEOFF_PURCHASES_FREQUENCY<-as.factor(dfreq$ONEOFF_PURCHASES_FREQUENCY)
dfreq$ONEOFF_PURCHASES_FREQUENCY<-as.factor(ifelse(dfreq$ONEOFF_PURCHASES_FREQUENCY==0.15,"Muy baja",ifelse(dfreq$ONEOFF_PURCHASES_FREQUENCY==0.35,"Baja",ifelse(dfreq$ONEOFF_PURCHASES_FREQUENCY==0.65,"Alta","Muy alta"))))
levels(dfreq$ONEOFF_PURCHASES_FREQUENCY)
## [1] "Alta" "Baja" "Muy alta" "Muy baja"
Para la variable BALANCE_FREQUENCY:
dfreq$BALANCE_FREQUENCY<-replace(dfreq$BALANCE_FREQUENCY,dfreq$BALANCE_FREQUENCY<0.25,0.15)
dfreq$BALANCE_FREQUENCY<-replace(dfreq$BALANCE_FREQUENCY,dfreq$BALANCE_FREQUENCY>=0.25 & dfreq$BALANCE_FREQUENCY<0.5,0.35)
dfreq$BALANCE_FREQUENCY<-replace(dfreq$BALANCE_FREQUENCY,dfreq$BALANCE_FREQUENCY>=0.5 & dfreq$BALANCE_FREQUENCY<0.75,0.65)
dfreq$BALANCE_FREQUENCY<-replace(dfreq$BALANCE_FREQUENCY,dfreq$BALANCE_FREQUENCY>=0.75,0.9)
dfreq$BALANCE_FREQUENCY<-as.factor(dfreq$BALANCE_FREQUENCY)
dfreq$BALANCE_FREQUENCY<-as.factor(ifelse(dfreq$BALANCE_FREQUENCY==0.15,"Muy baja",ifelse(dfreq$BALANCE_FREQUENCY==0.35,"Baja",ifelse(dfreq$BALANCE_FREQUENCY==0.65,"Alta","Muy alta"))))
levels(dfreq$BALANCE_FREQUENCY)
## [1] "Alta" "Baja" "Muy alta" "Muy baja"
Para la variable PURCHASES_FREQUENCY:
dfreq$PURCHASES_FREQUENCY<-replace(dfreq$PURCHASES_FREQUENCY,dfreq$PURCHASES_FREQUENCY<0.25,0.15)
dfreq$PURCHASES_FREQUENCY<-replace(dfreq$PURCHASES_FREQUENCY,dfreq$PURCHASES_FREQUENCY>=0.25 & dfreq$PURCHASES_FREQUENCY<0.5,0.35)
dfreq$PURCHASES_FREQUENCY<-replace(dfreq$PURCHASES_FREQUENCY,dfreq$PURCHASES_FREQUENCY>=0.5 & dfreq$PURCHASES_FREQUENCY<0.75,0.65)
dfreq$PURCHASES_FREQUENCY<-replace(dfreq$PURCHASES_FREQUENCY,dfreq$PURCHASES_FREQUENCY>=0.75,0.9)
dfreq$PURCHASES_FREQUENCY<-as.factor(dfreq$PURCHASES_FREQUENCY)
dfreq$PURCHASES_FREQUENCY<-as.factor(ifelse(dfreq$PURCHASES_FREQUENCY==0.15,"Muy baja",ifelse(dfreq$PURCHASES_FREQUENCY==0.35,"Baja",ifelse(dfreq$PURCHASES_FREQUENCY==0.65,"Alta","Muy alta"))))
Para la variable CASH_ADVANCE_FREQUENCY:
dfreq$CASH_ADVANCE_FREQUENCY<-replace(dfreq$CASH_ADVANCE_FREQUENCY,dfreq$CASH_ADVANCE_FREQUENCY<0.25,0.15)
dfreq$CASH_ADVANCE_FREQUENCY<-replace(dfreq$CASH_ADVANCE_FREQUENCY,dfreq$CASH_ADVANCE_FREQUENCY>=0.25 & dfreq$CASH_ADVANCE_FREQUENCY<0.5,0.35)
dfreq$CASH_ADVANCE_FREQUENCY<-replace(dfreq$CASH_ADVANCE_FREQUENCY,dfreq$CASH_ADVANCE_FREQUENCY>=0.5 & dfreq$CASH_ADVANCE_FREQUENCY<0.75,0.65)
dfreq$CASH_ADVANCE_FREQUENCY<-replace(dfreq$CASH_ADVANCE_FREQUENCY,dfreq$CASH_ADVANCE_FREQUENCY>=0.75,0.9)
dfreq$CASH_ADVANCE_FREQUENCY<-as.factor(dfreq$CASH_ADVANCE_FREQUENCY)
dfreq$CASH_ADVANCE_FREQUENCY<-as.factor(ifelse(dfreq$CASH_ADVANCE_FREQUENCY==0.15,"Muy baja",ifelse(dfreq$CASH_ADVANCE_FREQUENCY==0.35,"Baja",ifelse(dfreq$CASH_ADVANCE_FREQUENCY==0.65,"Alta","Muy alta"))))
Para la variable PURCHASES_INSTALLMENTS_FREQUENCY:
dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<-replace(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY,dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<0.25,0.15)
dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<-replace(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY,dfreq$PURCHASES_INSTALLMENTS_FREQUENCY>=0.25 & dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<0.5,0.35)
dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<-replace(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY,dfreq$PURCHASES_INSTALLMENTS_FREQUENCY>=0.5 & dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<0.75,0.65)
dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<-replace(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY,dfreq$PURCHASES_INSTALLMENTS_FREQUENCY>=0.75,0.9)
dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<-as.factor(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY)
dfreq$PURCHASES_INSTALLMENTS_FREQUENCY<-as.factor(ifelse(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY==0.15,"Muy baja",ifelse(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY==0.35,"Baja",ifelse(dfreq$PURCHASES_INSTALLMENTS_FREQUENCY==0.65,"Alta","Muy alta"))))
Para la variable CREDIT_LIMIT distinguiré entre grupos por debajo del primer cuartil, entre el primer y el tercer cuartil y por encima del tercer cuartil (de menos a más solventes):
summary(dfreq$CREDIT_LIMIT)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 50 1600 3000 4494 6500 30000
dfreq$CREDIT_LIMIT<-replace(dfreq$CREDIT_LIMIT,dfreq$CREDIT_LIMIT<1600,1000)
dfreq$CREDIT_LIMIT<-replace(dfreq$CREDIT_LIMIT,dfreq$CREDIT_LIMIT>=1600 & dfreq$CREDIT_LIMIT<6500,4000)
dfreq$CREDIT_LIMIT<-replace(dfreq$CREDIT_LIMIT,dfreq$CREDIT_LIMIT>=6500,7000)
dfreq$CREDIT_LIMIT<-as.factor(dfreq$CREDIT_LIMIT)
dfreq$CREDIT_LIMIT<-as.factor(ifelse(dfreq$CREDIT_LIMIT==1000,"Bajo",ifelse(dfreq$CREDIT_LIMIT==4000,"Medio","Elevado")))
Para la variable CASH_ADVANCE_TRX tomaremos el mismo criterio de los cuartiles para ditinguir entre pocas, medias y muchas:
summary(dfreq$CASH_ADVANCE_TRX)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.000 0.000 3.249 4.000 123.000
boxplot(dfreq$CASH_ADVANCE_TRX)
El resultado parece indicar que lo extraño es que sean más de 0 pues la mediana toma ese valor así que distinguiremos entre los que tengan 0 y los que no:
dfreq$CASH_ADVANCE_TRX<-replace(dfreq$CASH_ADVANCE_TRX,dfreq$CASH_ADVANCE_TRX>0,1)
dfreq$CASH_ADVANCE_TRX<-as.factor(dfreq$CASH_ADVANCE_TRX)
dfreq$CASH_ADVANCE_TRX<-as.factor(ifelse(dfreq$CASH_ADVANCE_TRX==0,"NO","SI"))
Para la variable PURCHASES_TRX:
summary(dfreq$PURCHASES_TRX)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 1.00 7.00 14.71 17.00 358.00
boxplot(dfreq$PURCHASES_TRX)
El 75% de las observaciones ha realizado menos de 17 compras así que tomaré esto como nivel para segmentar:
dfreq$PURCHASES_TRX<-replace(dfreq$PURCHASES_TRX,dfreq$PURCHASES_TRX<17,0)
dfreq$PURCHASES_TRX<-replace(dfreq$PURCHASES_TRX,dfreq$PURCHASES_TRX>=17,1)
dfreq$PURCHASES_TRX<-as.factor(dfreq$PURCHASES_TRX)
dfreq$PURCHASES_TRX<-as.factor(ifelse(dfreq$PURCHASES_TRX==0,"Pocas","Muchas"))
Para la variable PRC_FULL_PAYMENT:
dfreq$PRC_FULL_PAYMENT<-replace(dfreq$PRC_FULL_PAYMENT,dfreq$PRC_FULL_PAYMENT<0.25,0.15)
dfreq$PRC_FULL_PAYMENT<-replace(dfreq$PRC_FULL_PAYMENT,dfreq$PRC_FULL_PAYMENT>=0.25 & dfreq$PRC_FULL_PAYMENT<0.5,0.35)
dfreq$PRC_FULL_PAYMENT<-replace(dfreq$PRC_FULL_PAYMENT,dfreq$PRC_FULL_PAYMENT>=0.5 & dfreq$PRC_FULL_PAYMENT<0.75,0.65)
dfreq$PRC_FULL_PAYMENT<-replace(dfreq$PRC_FULL_PAYMENT,dfreq$PRC_FULL_PAYMENT>=0.75,0.9)
dfreq$PRC_FULL_PAYMENT<-as.factor(dfreq$PRC_FULL_PAYMENT)
dfreq$PRC_FULL_PAYMENT<-as.factor(ifelse(dfreq$PRC_FULL_PAYMENT==0.15,"Muy baja",ifelse(dfreq$PRC_FULL_PAYMENT==0.35,"Baja",ifelse(dfreq$PRC_FULL_PAYMENT==0.65,"Alta","Muy alta"))))
Y finalmente, para TENURE habrá que distinguir entre los que lleven menos de 12 meses o 12 en adelante:
dfreq$TENURE<-replace(dfreq$TENURE,dfreq$TENURE<12,0)
dfreq$TENURE<-replace(dfreq$TENURE,dfreq$TENURE>=12,1)
dfreq$TENURE<-as.factor(dfreq$TENURE)
dfreq$TENURE<-as.factor(ifelse(dfreq$TENURE==0,"Nuevos","Antiguos"))
Con esto ya concluiría la parte de hacer grupos y el resultado que ofrecería FAMD con estas modificaciones es:
res.famd.grupos <- FAMD(dfreq,ncp=5,graph = FALSE)
a <- fviz_eig(res.famd.grupos,
choice='eigenvalue',
geom='line')
b <- fviz_eig(res.famd.grupos)
grid.arrange(a, b, ncol=2)
summary(res.famd.grupos$eig)
## eigenvalue percentage of variance cumulative percentage of variance
## Min. :1.473 Min. : 4.909 Min. :14.93
## 1st Qu.:1.571 1st Qu.: 5.236 1st Qu.:25.95
## Median :1.841 Median : 6.136 Median :32.09
## Mean :2.534 Mean : 8.447 Mean :30.51
## 3rd Qu.:3.308 3rd Qu.:11.027 3rd Qu.:37.33
## Max. :4.478 Max. :14.927 Max. :42.23
Con las primeras 5 variables conseguiría explicar un 42% de la varianza, menos que sin introducir tantos grupos como al principio pero no un resultado tan poco aclarativo como si consideramos todos los factores como grupos individuales. Ahora es posible continuar con el análisis usando estos datos y crear gráficos variados para ver estas influencias.
Como cuantas más dimensiones se usen, más fidedigna es la distribución de los puntos a la realidad, usaré un gráfico 3D usando la laibrería Plotly para representar 3 componentes probando con algunos de los factores creados. Este tipo de gráfico es interactivo, por lo que no he podido pasarlo a PDF y es el motivo de que el documento sea HTML.
La primera distribución que me gustaría comprobar es la de CREDIT_LIMIT:
library(plotly)
val_df <- as.data.frame(res.famd.grupos$ind)
x <- cbind(dfreq, val_df[1:3])
## Plot
plot_ly(x,
x = ~coord.Dim.1,
y = ~coord.Dim.2,
z = ~coord.Dim.3,
color = ~CREDIT_LIMIT,
size = 15)
Usando esta clasificación es bastante claro que los clientes más abundantes son los que tienen límites más altos y que se reparten de manera más uniforme a lo largo de las dimensiones 1 y 2 mientras que los de bajo límite se concentran en el codo, la zona más usual.
También según la frecuencia de las compras:
val_df2 <- as.data.frame(res.famd.grupos$ind)
x <- cbind(dfreq, val_df2[1:3])
## Plot
plot_ly(x,
x = ~coord.Dim.1,
y = ~coord.Dim.2,
z = ~coord.Dim.3,
color = ~PURCHASES_FREQUENCY,
size=20)
Las personas con frecuencias altas están repartidas a lo largo de la componente 1 y las de baja frecuencia a lo largo de la componente 2 habiendo una separación muy clara entre ambas.
En cuanto al análisis de los cos2:
fviz_famd_var(res.famd.grupos, 'var',
axes = c(1, 2),
col.var = 'cos2')
La información que muestra el gráfico es que Balance, Cash Advance y Purchases son las que más explican componentes 1 y 2 al estar más alejadas del centro. Variables como Payments o Purchases_Installments_Frequency tienden a ser explicadas más por una combinación de ambas dimensiones.
Para entender mejor la relación entre los tipos de variables y las dimensiones se puede emplear el paquete PCAmixdata de la siguiente manera:
split <- splitmix(dfreq)
res.pcamix <- PCAmix(X.quanti=split$X.quanti,
X.quali=split$X.quali,
rename.level = T)
res.pcarot <- PCArot(res.pcamix, dim=2,
graph=FALSE)
plot(res.pcarot, choice="sqload",
coloring.var=TRUE, axes=c(1, 2))
Las variables con flechas más largas son las que más contribuyen a la varianza total del conjunto. Muchas son categóricas pero las PURCHASES, PAYMENTS y BALANCE también contribuyen mucho.
Como parte final del trabajo, toca hacer análisis cluster para terminar de dar forma a los distintos grupos vistos durante los análisis PCA y FAMD previos. Para empezar usaré el conjunto de datos modificado, con las variables categóricas:
datos_cluster<-dfreq
Y se crea la matriz de distancias con el método Gower al no tener sentido usar el método kmeans:
gower_dist<-daisy(datos_cluster,metric = "gower")
gower_mat<-as.matrix(gower_dist)
summary(gower_dist)
## 40046775 dissimilarities, summarized :
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000019 0.209170 0.300640 0.290520 0.366500 0.792690
## Metric : mixed ; Types = I, N, I, I, I, I, N, N, N, N, N, N, N, I, I, N, N
## Number of objects : 8950
Para ver si no está mal planteado, echo un vistazo a cuáles son los 2 clientes más similares según las distancias de Gower:
datos_cluster[which(gower_mat == min(gower_mat[gower_mat != min(gower_mat)]), arr.ind = TRUE)[1, ], ]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C17582 18.12095 Alta 57 57
## C11304 18.77631 Alta 59 59
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C17582 0 0 Muy baja
## C11304 0 0 Muy baja
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C17582 Muy baja Muy baja
## C11304 Muy baja Muy baja
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C17582 Muy baja NO Pocas Bajo
## C11304 Muy baja NO Pocas Bajo
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C17582 118.4387 54.13871 Muy baja Nuevos
## C11304 127.6231 55.55323 Muy baja Nuevos
Y los más diferentes:
datos_cluster[which(gower_mat == max(gower_mat[gower_mat != max(gower_mat)]), arr.ind = TRUE)[1, ], ]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C13606 98.41895 Alta 0.0 0.00
## C10523 13479.28821 Muy alta 41050.4 40624.06
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C13606 0.00 2327.567 Muy baja
## C10523 426.34 0.000 Muy alta
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C13606 Muy baja Muy baja
## C10523 Alta Baja
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C13606 Baja SI Pocas Bajo
## C10523 Muy baja NO Muchas Elevado
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C13606 2535.544 62.28124 Baja Nuevos
## C10523 36066.751 15914.48462 Muy baja Antiguos
Ambos resultados muestran bastante coherencia con lo que esperaríamos ver pues los más parecidos tienen un saldo en cuenta similar, las mismas frecuencias, etc. Todo lo contrario sucede con los más diferentes por lo que parece que va bien encaminado el análisis.
Para ver el número óptimo de clusters que crear, al ser un dataset muy grande, es preferible coger una muestra y extraer de ella las conclusiones. Para ello:
set.seed(123)
datos_reducidos<-sample_n(datos_cluster,4000)
gower_dist2<-daisy(datos_reducidos,metric = "gower")
gower_mat2<-as.matrix(gower_dist2)
summary(gower_dist2)
## 7998000 dissimilarities, summarized :
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000394 0.2173900 0.3019300 0.2934300 0.3689400 0.8006500
## Metric : mixed ; Types = I, N, I, I, I, I, N, N, N, N, N, N, N, I, I, N, N
## Number of objects : 4000
Si comparo los datos de esta matriz de distancias reducida con los anteriores, se ve que no hay una gran diferencia entre los valores. La máxima distancia, por ejemplo, en este es 0.8006 y en el completo es de 0.7926 y la media es en este 0.2934 y en el completo de 0.2905. Son prácticamente iguales y se pueden extrapolar los resultados de uno al otro.
Por tanto, según esta muestra de todos los clientes, el número óptimo de grupos sería:
sil_width <- c(NA)
for(i in 2:7){
pam_fit <- pam(gower_dist2,
diss = TRUE,
k = i)
sil_width[i] <- pam_fit$silinfo$avg.width
}
# Plot sihouette width (higher is better)
plot(1:7, sil_width,
xlab = "Número de Clusters",
ylab = "Silhouette Width")
lines(1:7, sil_width)
Muestra que el número óptimo de grupos 2, 3 o 4 aproximadamente.
Probaré primero con 4 pues es el punto que actuaría de codo en el gráfico y si el análisis no resulta muy efectivo investigamos si con 3 es más preciso:
pam_fit<-pam(gower_dist,diss = TRUE,k=4)
Las observaciones más representativas de cada grupo serían:
datos_cluster[pam_fit$medoids, ]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C13072 124.7325 Muy alta 301.07 301.07
## C17967 1836.5653 Muy alta 0.00 0.00
## C18621 882.5813 Muy alta 2421.34 1661.76
## C18904 79.8616 Muy alta 427.36 0.00
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C13072 0.00 0.000 Muy baja
## C17967 0.00 1265.553 Muy baja
## C18621 759.58 0.000 Muy alta
## C18904 427.36 0.000 Muy alta
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C13072 Muy baja Muy baja
## C17967 Muy baja Muy baja
## C18621 Muy alta Muy alta
## C18904 Muy baja Muy alta
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C13072 Muy baja NO Pocas Medio
## C17967 Muy baja SI Pocas Medio
## C18621 Muy baja NO Muchas Medio
## C18904 Muy baja NO Pocas Bajo
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C13072 732.9519 133.9350 Muy baja Antiguos
## C17967 713.1244 476.3120 Muy baja Antiguos
## C18621 1997.3231 237.2021 Muy baja Antiguos
## C18904 410.3684 164.6423 Muy baja Antiguos
Para ver las características de cada uno de los clusters:
pam_results <- datos_cluster %>%
mutate(cluster = pam_fit$clustering) %>%
group_by(cluster) %>%
do(the_summary = summary(.))
pam_results$the_summary
## [[1]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0.0 Alta :345 Min. : 0.0 Min. : 0.0
## 1st Qu.: 23.2 Baja :303 1st Qu.: 117.0 1st Qu.: 0.0
## Median : 124.7 Muy alta:997 Median : 324.1 Median : 163.8
## Mean : 618.3 Muy baja:191 Mean : 546.2 Mean : 416.8
## 3rd Qu.: 906.2 3rd Qu.: 718.4 3rd Qu.: 585.5
## Max. :12323.8 Max. :17945.0 Max. :17945.0
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.0 Min. :0 Alta :454
## 1st Qu.: 0.0 1st Qu.:0 Baja :547
## Median : 0.0 Median :0 Muy alta:111
## Mean : 129.6 Mean :0 Muy baja:724
## 3rd Qu.: 137.6 3rd Qu.:0
## Max. :12541.0 Max. :0
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta : 123 Alta : 200
## Baja : 335 Baja : 327
## Muy alta: 102 Muy alta: 0
## Muy baja:1276 Muy baja:1309
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 0 NO:1836 Muchas: 35 Bajo : 305
## Baja : 0 SI: 0 Pocas :1801 Elevado: 339
## Muy alta: 0 Medio :1192
## Muy baja:1836
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0.0 Min. : 0.038 Alta : 99 Antiguos:1617
## 1st Qu.: 250.3 1st Qu.: 116.935 Baja : 122 Nuevos : 219
## Median : 513.8 Median : 174.456 Muy alta: 184
## Mean : 929.6 Mean : 446.215 Muy baja:1431
## 3rd Qu.: 991.4 3rd Qu.: 329.359
## Max. :50721.5 Max. :30528.432
## cluster
## Min. :1
## 1st Qu.:1
## Median :1
## Mean :1
## 3rd Qu.:1
## Max. :1
##
## [[2]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0 Alta : 259 Min. : 0.0 Min. : 0.0
## 1st Qu.: 835 Baja : 163 1st Qu.: 0.0 1st Qu.: 0.0
## Median : 1592 Muy alta:2946 Median : 0.0 Median : 0.0
## Mean : 2310 Muy baja: 89 Mean : 252.5 Mean : 189.4
## 3rd Qu.: 3044 3rd Qu.: 246.6 3rd Qu.: 117.6
## Max. :16305 Max. :22101.8 Max. :22101.8
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.00 Min. : 14.22 Alta : 334
## 1st Qu.: 0.00 1st Qu.: 408.11 Baja : 380
## Median : 0.00 Median : 1256.71 Muy alta: 162
## Mean : 63.26 Mean : 2052.88 Muy baja:2581
## 3rd Qu.: 0.00 3rd Qu.: 2757.58
## Max. :4059.93 Max. :47137.21
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta : 114 Alta : 148
## Baja : 301 Baja : 223
## Muy alta: 46 Muy alta: 64
## Muy baja:2996 Muy baja:3022
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 448 NO: 0 Muchas: 92 Bajo : 809
## Baja :1201 SI:3457 Pocas :3365 Elevado: 807
## Muy alta: 153 Medio :1841
## Muy baja:1655
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0.0 Min. : 0.12 Alta : 46 Antiguos:2752
## 1st Qu.: 429.6 1st Qu.: 267.81 Baja : 107 Nuevos : 705
## Median : 891.6 Median : 525.17 Muy alta: 43
## Mean : 1789.3 Mean : 1030.64 Muy baja:3261
## 3rd Qu.: 1941.5 3rd Qu.: 1111.25
## Max. :39462.0 Max. :61031.62
## cluster
## Min. :2
## 1st Qu.:2
## Median :2
## Mean :2
## 3rd Qu.:2
## Max. :2
##
## [[3]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0.0 Alta : 39 Min. : 96.62 Min. : 0.0
## 1st Qu.: 302.1 Baja : 15 1st Qu.: 1307.16 1st Qu.: 445.1
## Median : 1045.5 Muy alta:1865 Median : 2147.01 Median : 1197.0
## Mean : 1968.1 Muy baja: 6 Mean : 3082.93 Mean : 1913.3
## 3rd Qu.: 2707.1 3rd Qu.: 3612.24 3rd Qu.: 2326.1
## Max. :19043.1 Max. :49039.57 Max. :40761.2
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.0 Min. : 0.0 Alta : 91
## 1st Qu.: 356.7 1st Qu.: 0.0 Baja : 10
## Median : 789.8 Median : 0.0 Muy alta:1824
## Mean : 1170.2 Mean : 669.5 Muy baja: 0
## 3rd Qu.: 1478.0 3rd Qu.: 291.3
## Max. :15497.2 Max. :29282.1
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta :387 Alta : 293
## Baja :367 Baja : 178
## Muy alta:757 Muy alta:1258
## Muy baja:414 Muy baja: 196
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 79 NO:1331 Muchas:1900 Bajo : 83
## Baja : 192 SI: 594 Pocas : 25 Elevado: 811
## Muy alta: 36 Medio :1031
## Muy baja:1618
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0 Min. : 0.32 Alta : 121 Antiguos:1826
## 1st Qu.: 1111 1st Qu.: 184.47 Baja : 157 Nuevos : 99
## Median : 1987 Median : 334.18 Muy alta: 338
## Mean : 3147 Mean : 1046.06 Muy baja:1309
## 3rd Qu.: 3696 3rd Qu.: 964.10
## Max. :46931 Max. :76406.21
## cluster
## Min. :3
## 1st Qu.:3
## Median :3
## Mean :3
## 3rd Qu.:3
## Max. :3
##
## [[4]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0.00 Alta : 159 Min. : 12.0 Min. : 0.00
## 1st Qu.: 35.38 Baja : 90 1st Qu.: 250.9 1st Qu.: 0.00
## Median : 127.94 Muy alta:1426 Median : 458.6 Median : 0.00
## Mean : 630.11 Muy baja: 57 Mean : 674.6 Mean : 115.14
## 3rd Qu.: 823.03 3rd Qu.: 805.9 3rd Qu.: 45.16
## Max. :16115.60 Max. :22500.0 Max. :8008.50
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.0 Min. : 0.0 Alta : 260
## 1st Qu.: 214.7 1st Qu.: 0.0 Baja : 166
## Median : 380.6 Median : 0.0 Muy alta:1306
## Mean : 560.0 Mean : 216.7 Muy baja: 0
## 3rd Qu.: 643.2 3rd Qu.: 0.0
## Max. :22500.0 Max. :18857.1
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta : 30 Alta : 299
## Baja : 99 Baja : 261
## Muy alta: 19 Muy alta:1138
## Muy baja:1584 Muy baja: 34
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 24 NO:1461 Muchas: 268 Bajo :1038
## Baja : 84 SI: 271 Pocas :1464 Elevado: 296
## Muy alta: 10 Medio : 398
## Muy baja:1614
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0.0 Min. : 0.02 Alta : 168 Antiguos:1389
## 1st Qu.: 269.9 1st Qu.: 135.71 Baja : 201 Nuevos : 343
## Median : 534.0 Median : 176.32 Muy alta: 277
## Mean : 900.9 Mean : 682.29 Muy baja:1086
## 3rd Qu.: 1093.2 3rd Qu.: 438.32
## Max. :40627.6 Max. :38512.12
## cluster
## Min. :4
## 1st Qu.:4
## Median :4
## Mean :4
## 3rd Qu.:4
## Max. :4
Antes de centrarse en las características, represento para ver cómo serían los grupos teniendo en cuenta que no hay que escalar aquellas variables que son factores:
datos_scaled_cluster<-scale(select(datos_cluster,-c(BALANCE_FREQUENCY,
PURCHASES_FREQUENCY,
ONEOFF_PURCHASES_FREQUENCY,
PURCHASES_INSTALLMENTS_FREQUENCY,
PRC_FULL_PAYMENT,
CASH_ADVANCE_FREQUENCY,
CREDIT_LIMIT,
CASH_ADVANCE_TRX,
PURCHASES_TRX,
TENURE)))
pam_fit$data<-datos_scaled_cluster
fviz_cluster(pam_fit,
palette = c("#00AFBB", "green","#FC4E07","red"),
ellipse.type = "t",
geom = c("point"),
ggtheme = theme_classic())
Al haber muchas variables, una representación en 2D no permite distinguir con precisión cómo se distribuyen los distintos grupos por lo que aquí también es interesante hacer una representación 3D sobre la descomposición de FAMD coloreando con los cluster que he obtenido como resultado de aplicar el algoritmo PAM:
val_df2 <- as.data.frame(res.famd.grupos$ind)
dfreq$CLUSTER<-pam_fit$clustering
x <- cbind(dfreq, val_df2[1:3])
## Plot
plot_ly(x,
x = ~coord.Dim.1,
y = ~coord.Dim.2,
z = ~coord.Dim.3,
color = ~CLUSTER,
size=20)
Así se distingue la distribución a lo largo de la tercera componente mucho mejor y cobra más sentido la presencia de 4 tipos de clientes.
Usando polígonos de confianza, primero se crea un dendograma:
dendograma_gower<-hclust(gower_dist, method="complete")
plot(dendograma_gower)
Y el código para representar:
fviz_cluster(list(data = datos_scaled_cluster, cluster = cutree(dendograma_gower,4)),
palette = c("#2E9FDF", "#00AFBB","orange","blue"),
ellipse.type = "convex",
show.clust.cent = FALSE,
geom = c("point"),
pointsize = 0.5,
ggtheme = theme_minimal()
)
Este último no permite distinguir muy adecuadamente y hace parecer que se produce mucho solapamiento entre clusters. De otra manera:
fviz_cluster(pam_fit, data = datos_scaled_cluster,
palette = c("red","blue","yellow","green"),
ellipse.type = "norm", # elipse de concentración
pointsize = 0.5,
geom = c("point"),
ggtheme = theme_minimal()
)
A continuación iré describiendo las características numéricas propias de cada cluster:
result<-datos_cluster[pam_fit$medoids, ]
result
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C13072 124.7325 Muy alta 301.07 301.07
## C17967 1836.5653 Muy alta 0.00 0.00
## C18621 882.5813 Muy alta 2421.34 1661.76
## C18904 79.8616 Muy alta 427.36 0.00
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C13072 0.00 0.000 Muy baja
## C17967 0.00 1265.553 Muy baja
## C18621 759.58 0.000 Muy alta
## C18904 427.36 0.000 Muy alta
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C13072 Muy baja Muy baja
## C17967 Muy baja Muy baja
## C18621 Muy alta Muy alta
## C18904 Muy baja Muy alta
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C13072 Muy baja NO Pocas Medio
## C17967 Muy baja SI Pocas Medio
## C18621 Muy baja NO Muchas Medio
## C18904 Muy baja NO Pocas Bajo
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C13072 732.9519 133.9350 Muy baja Antiguos
## C17967 713.1244 476.3120 Muy baja Antiguos
## C18621 1997.3231 237.2021 Muy baja Antiguos
## C18904 410.3684 164.6423 Muy baja Antiguos
Como hay muchas variables por la parte descriptiva, es mejor analizar los mediodes o las observaciones más representativas para cada uno de los grupos y contrastar las conclusiones que se pueden sacar de cada uno con las características de su grupo:
result[1,]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C13072 124.7325 Muy alta 301.07 301.07
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C13072 0 0 Muy baja
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C13072 Muy baja Muy baja
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C13072 Muy baja NO Pocas Medio
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C13072 732.9519 133.935 Muy baja Antiguos
pam_results$the_summary[[1]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0.0 Alta :345 Min. : 0.0 Min. : 0.0
## 1st Qu.: 23.2 Baja :303 1st Qu.: 117.0 1st Qu.: 0.0
## Median : 124.7 Muy alta:997 Median : 324.1 Median : 163.8
## Mean : 618.3 Muy baja:191 Mean : 546.2 Mean : 416.8
## 3rd Qu.: 906.2 3rd Qu.: 718.4 3rd Qu.: 585.5
## Max. :12323.8 Max. :17945.0 Max. :17945.0
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.0 Min. :0 Alta :454
## 1st Qu.: 0.0 1st Qu.:0 Baja :547
## Median : 0.0 Median :0 Muy alta:111
## Mean : 129.6 Mean :0 Muy baja:724
## 3rd Qu.: 137.6 3rd Qu.:0
## Max. :12541.0 Max. :0
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta : 123 Alta : 200
## Baja : 335 Baja : 327
## Muy alta: 102 Muy alta: 0
## Muy baja:1276 Muy baja:1309
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 0 NO:1836 Muchas: 35 Bajo : 305
## Baja : 0 SI: 0 Pocas :1801 Elevado: 339
## Muy alta: 0 Medio :1192
## Muy baja:1836
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0.0 Min. : 0.038 Alta : 99 Antiguos:1617
## 1st Qu.: 250.3 1st Qu.: 116.935 Baja : 122 Nuevos : 219
## Median : 513.8 Median : 174.456 Muy alta: 184
## Mean : 929.6 Mean : 446.215 Muy baja:1431
## 3rd Qu.: 991.4 3rd Qu.: 329.359
## Max. :50721.5 Max. :30528.432
## cluster
## Min. :1
## 1st Qu.:1
## Median :1
## Mean :1
## 3rd Qu.:1
## Max. :1
Respecto al primer grupo, estaría representado por clientes antiguos con un saldo en cuenta bajo, que realizan relativamente bastantes compras pero las que realizan no son de una vez sino a plazos y por ello los adelantos de efectivo son muy bajos o inexistentes. El límite de crédito que poseen es normal, medio y destacan más porque los pagos (como recibos) sí son más frecuentes que las compras por lo que parece tratarse de clientes estándar que tienen la cuenta tanto para domiciliar recibos como para realizar compras cotidianas pero sin endeudarse en exceso.
result[2,]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C17967 1836.565 Muy alta 0 0
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C17967 0 1265.553 Muy baja
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C17967 Muy baja Muy baja
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C17967 Muy baja SI Pocas Medio
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C17967 713.1244 476.312 Muy baja Antiguos
pam_results$the_summary[[2]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0 Alta : 259 Min. : 0.0 Min. : 0.0
## 1st Qu.: 835 Baja : 163 1st Qu.: 0.0 1st Qu.: 0.0
## Median : 1592 Muy alta:2946 Median : 0.0 Median : 0.0
## Mean : 2310 Muy baja: 89 Mean : 252.5 Mean : 189.4
## 3rd Qu.: 3044 3rd Qu.: 246.6 3rd Qu.: 117.6
## Max. :16305 Max. :22101.8 Max. :22101.8
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.00 Min. : 14.22 Alta : 334
## 1st Qu.: 0.00 1st Qu.: 408.11 Baja : 380
## Median : 0.00 Median : 1256.71 Muy alta: 162
## Mean : 63.26 Mean : 2052.88 Muy baja:2581
## 3rd Qu.: 0.00 3rd Qu.: 2757.58
## Max. :4059.93 Max. :47137.21
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta : 114 Alta : 148
## Baja : 301 Baja : 223
## Muy alta: 46 Muy alta: 64
## Muy baja:2996 Muy baja:3022
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 448 NO: 0 Muchas: 92 Bajo : 809
## Baja :1201 SI:3457 Pocas :3365 Elevado: 807
## Muy alta: 153 Medio :1841
## Muy baja:1655
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0.0 Min. : 0.12 Alta : 46 Antiguos:2752
## 1st Qu.: 429.6 1st Qu.: 267.81 Baja : 107 Nuevos : 705
## Median : 891.6 Median : 525.17 Muy alta: 43
## Mean : 1789.3 Mean : 1030.64 Muy baja:3261
## 3rd Qu.: 1941.5 3rd Qu.: 1111.25
## Max. :39462.0 Max. :61031.62
## cluster
## Min. :2
## 1st Qu.:2
## Median :2
## Mean :2
## 3rd Qu.:2
## Max. :2
El segundo grupo de clientes, está constituido por clientes que tienen el saldo en cuenta más elevado de todos los grupos (siempre atendiendo a la mediana para evitar sesgos por los outliers). Las compras que tienen son muy reducidas pero los adelantos de efectivo y los pagos sí son elevados. Parece ser el tipo de clientes solvente que no se dedica tanto al gasto sino que usan la cuenta más como soporte para recibos o para realziar aportaciones a fondos de pensiones o de inversión.
result[3,]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C18621 882.5813 Muy alta 2421.34 1661.76
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C18621 759.58 0 Muy alta
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C18621 Muy alta Muy alta
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C18621 Muy baja NO Muchas Medio
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C18621 1997.323 237.2021 Muy baja Antiguos
pam_results$the_summary[[3]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0.0 Alta : 39 Min. : 96.62 Min. : 0.0
## 1st Qu.: 302.1 Baja : 15 1st Qu.: 1307.16 1st Qu.: 445.1
## Median : 1045.5 Muy alta:1865 Median : 2147.01 Median : 1197.0
## Mean : 1968.1 Muy baja: 6 Mean : 3082.93 Mean : 1913.3
## 3rd Qu.: 2707.1 3rd Qu.: 3612.24 3rd Qu.: 2326.1
## Max. :19043.1 Max. :49039.57 Max. :40761.2
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.0 Min. : 0.0 Alta : 91
## 1st Qu.: 356.7 1st Qu.: 0.0 Baja : 10
## Median : 789.8 Median : 0.0 Muy alta:1824
## Mean : 1170.2 Mean : 669.5 Muy baja: 0
## 3rd Qu.: 1478.0 3rd Qu.: 291.3
## Max. :15497.2 Max. :29282.1
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta :387 Alta : 293
## Baja :367 Baja : 178
## Muy alta:757 Muy alta:1258
## Muy baja:414 Muy baja: 196
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 79 NO:1331 Muchas:1900 Bajo : 83
## Baja : 192 SI: 594 Pocas : 25 Elevado: 811
## Muy alta: 36 Medio :1031
## Muy baja:1618
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0 Min. : 0.32 Alta : 121 Antiguos:1826
## 1st Qu.: 1111 1st Qu.: 184.47 Baja : 157 Nuevos : 99
## Median : 1987 Median : 334.18 Muy alta: 338
## Mean : 3147 Mean : 1046.06 Muy baja:1309
## 3rd Qu.: 3696 3rd Qu.: 964.10
## Max. :46931 Max. :76406.21
## cluster
## Min. :3
## 1st Qu.:3
## Median :3
## Mean :3
## 3rd Qu.:3
## Max. :3
El tercer grupo de clientes está compuesto por clientes con un saldo en cuenta medio-alto pero que, a diferencia del segundo grupo, tienen una elevada cantidad de compras con importes también altos. Los pagos igualmente tienen la cuantía de los del segundo grupo pero una diferencia notable es que no solicitan apenas anticipos de efectivo y tienen la mayor cantidad de representantes con límite de crédito alto. Parece tratarse de clientes solventes que pueden permitirse realizar compras y pagoos sin necesidad de endeudarse o pedir anticipos.
result[4,]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## C18904 79.8616 Muy alta 427.36 0
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## C18904 427.36 0 Muy alta
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## C18904 Muy baja Muy alta
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## C18904 Muy baja NO Pocas Bajo
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## C18904 410.3684 164.6423 Muy baja Antiguos
pam_results$the_summary[[4]]
## BALANCE BALANCE_FREQUENCY PURCHASES ONEOFF_PURCHASES
## Min. : 0.00 Alta : 159 Min. : 12.0 Min. : 0.00
## 1st Qu.: 35.38 Baja : 90 1st Qu.: 250.9 1st Qu.: 0.00
## Median : 127.94 Muy alta:1426 Median : 458.6 Median : 0.00
## Mean : 630.11 Muy baja: 57 Mean : 674.6 Mean : 115.14
## 3rd Qu.: 823.03 3rd Qu.: 805.9 3rd Qu.: 45.16
## Max. :16115.60 Max. :22500.0 Max. :8008.50
## INSTALLMENTS_PURCHASES CASH_ADVANCE PURCHASES_FREQUENCY
## Min. : 0.0 Min. : 0.0 Alta : 260
## 1st Qu.: 214.7 1st Qu.: 0.0 Baja : 166
## Median : 380.6 Median : 0.0 Muy alta:1306
## Mean : 560.0 Mean : 216.7 Muy baja: 0
## 3rd Qu.: 643.2 3rd Qu.: 0.0
## Max. :22500.0 Max. :18857.1
## ONEOFF_PURCHASES_FREQUENCY PURCHASES_INSTALLMENTS_FREQUENCY
## Alta : 30 Alta : 299
## Baja : 99 Baja : 261
## Muy alta: 19 Muy alta:1138
## Muy baja:1584 Muy baja: 34
##
##
## CASH_ADVANCE_FREQUENCY CASH_ADVANCE_TRX PURCHASES_TRX CREDIT_LIMIT
## Alta : 24 NO:1461 Muchas: 268 Bajo :1038
## Baja : 84 SI: 271 Pocas :1464 Elevado: 296
## Muy alta: 10 Medio : 398
## Muy baja:1614
##
##
## PAYMENTS MINIMUM_PAYMENTS PRC_FULL_PAYMENT TENURE
## Min. : 0.0 Min. : 0.02 Alta : 168 Antiguos:1389
## 1st Qu.: 269.9 1st Qu.: 135.71 Baja : 201 Nuevos : 343
## Median : 534.0 Median : 176.32 Muy alta: 277
## Mean : 900.9 Mean : 682.29 Muy baja:1086
## 3rd Qu.: 1093.2 3rd Qu.: 438.32
## Max. :40627.6 Max. :38512.12
## cluster
## Min. :4
## 1st Qu.:4
## Median :4
## Mean :4
## 3rd Qu.:4
## Max. :4
El último grupo de clientes está formado por personas con poca capacidad adquisitiva (pues tienen los menores saldos), el límite de crédito es eminentemente bajo y, acorde a ello, las compras no son frecuentes ni elevados. Sí se nota más relevancia de los pagos (pues serán sobre todo pagos de recibos) y tampoco solicitan anticipos de efectivo ya que no abordarán compras de importes muy elevados.